home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #03 (Aug85-Sep85) / Pascal / Pascal Vol. 1 #10 / Get_Fortune < prev    next >
Text File  |  1985-07-13  |  6KB  |  264 lines
  1. program Apple_talk_Access;{ by Alan Wootton 7/85 }
  2.  type
  3.   ptr = ^integer;
  4.   strptr = ^str255;
  5.  
  6.   Bsplit = packed array[0..1] of char;
  7.  
  8.   AddrBlockRec = record
  9.     aNet : integer;
  10.     aNode_aSocket : Bsplit
  11.    end;
  12.  
  13.   BDSElement = record
  14.     buffSize : integer;
  15.     buffPtr : ptr;
  16.     datasize : integer;
  17.     userbytes : longint
  18.    end;
  19.  
  20.   BDSType = array[0..7] of BDSElement;
  21.  
  22.   NtTuple = record
  23.     NetworkNumber : integer;
  24.     NodeID_SocketNumber : Bsplit;
  25.     none_ObjectName : Bsplit;
  26.     entityname : array[0..42] of integer;
  27.    end;
  28.  
  29.   NamesTableEntry = record
  30.     nextEntry : ^NamesTableEntry;
  31.     NetworkNumber : integer;
  32.     NodeID_SocketNumber : Bsplit;
  33.     none_ObjectName : Bsplit;
  34.     entityname : array[0..42] of integer;
  35.    end;
  36.  
  37. { Parameter Block information, heavily modified for Appletalk}
  38.  
  39.   ParamBlkPtr = ^ParamBlockRec;
  40.   ParamBlockRec = record{ data structure for control call }
  41.     qLink : Ptr;
  42.     qType : integer;
  43.     ioTrap : integer;
  44.     ioCmdAddr : ptr;
  45.     ioCompletion : ptr;
  46.     reqTid : integer;
  47.     ioNamePtr : ^str255;{ also UserData }
  48.     ioVrefnum : integer;
  49.     ioRefNum : integer;
  50.     csCode : integer;
  51.     case integer of
  52.      0 : (
  53.        ATPSocket_ATPFlags : Bsplit;
  54.        AddrBlock : AddrBlockrec;
  55.        ReqLength : integer;
  56.        Reqpointer : ptr;
  57.        BDSpointer : ^BDSelement;
  58.        numofBuffs_timeoutVal : Bsplit;
  59.        numofResps_retrycount : Bsplit
  60.      );
  61.      1 : (
  62.        curRBitmap_ATPflags : Bsplit;
  63.        dummy1 : longint;
  64.        confirmAddr : ptr;
  65.        dummy2 : array[0..2] of integer;
  66.        bitMap_BDSsize : Bsplit;
  67.        transID : integer
  68.      );
  69.      2 : (
  70.        interval_count : Bsplit;
  71.        ntQElPtr : ^namesTableEntry;
  72.        verifyFlag_none : Bsplit;
  73.        dummy3 : integer;
  74.        newSocket_none : Bsplit;
  75.        dummy4 : longint;
  76.        rspNum_none : Bsplit
  77.      );
  78.      3 : (
  79.        dummy5 : integer;
  80.        entityPtr : ^char;{ actually three packed str's }
  81.        retBuffPtr : ptr;
  82.        retbuffsize : integer;
  83.        maxtoget : integer;
  84.        numgotten : integer
  85.      )
  86.    end;
  87.  
  88. { common OS trap code, could be done with 'Generic' call }
  89.  function filecall (Pb : ParamBlkPtr;
  90.          trap : integer) : integer;{ OSError }
  91.   var
  92.    d0, a0 : longint;
  93.    access : array[0..12] of integer;
  94.  begin
  95.   stuffHex(@access, '2848548C41FA000C309F245F265F20522013FFFF224826804ED4');
  96.   a0 := ord(pb);
  97.   inlineP($4E75, @d0, @a0, trap, @access);
  98.   filecall := loword(d0);
  99.  end;
  100.  
  101.  procedure pack3str (strP : strptr;
  102.          s1, s2, s3 : str255);
  103.  begin
  104.   strP^ := s1;
  105.   strP := pointer(ord(strP) + length(strP^) + 1);
  106.   strP^ := s2;
  107.   strP := pointer(ord(strP) + length(strP^) + 1);
  108.   strP^ := s3;
  109.  end;
  110.  
  111.  function ATPLoad : integer;{ OSError }
  112.   type
  113.    r = record
  114.      use : char;
  115.     end;
  116.   var
  117.    pblock : ParamBlockRec;
  118.    Tstr : str255;
  119.    PortBUseP : ^r;
  120.    SPConfigP : ^char;
  121.    err : integer;
  122.  begin
  123.   pBlock.ioNamePtr := @Tstr;
  124.   pBlock.dummy5 := 0;{ ioPermssn }
  125.   PortBUseP := pointer($291);
  126.   SPConfigP := pointer($1FB);
  127.   with PortBUseP^ do
  128.    begin
  129.     writeln(' PortBuse is ', ord(use));
  130.     if ord(use) > 127 then
  131.      begin
  132.       err := -98;{ assume portNotCf }
  133.       if (ord(SPConfigP^) mod 16) < 2 then
  134.        begin
  135.         Tstr := '.MPP';
  136.         err := filecall(@pBlock, $A000);{ open }
  137.        end
  138.      end
  139.     else if (ord(use) mod 16) <> 1 then
  140.      err := -97;{  PortInUse }
  141.     if (not odd((ord(use) div 16))) and (err = 0) then
  142.      begin
  143.       Tstr := '.ATP';
  144.       err := filecall(@pBlock, $A000);{ open }
  145.      end;
  146.    end;{ of with }
  147.   ATPLoad := err;
  148.  end;{ of function }
  149.  
  150.  function ATPcall (Pb : ParamBlkPtr) : integer;
  151.  begin
  152.   Pb^.ioRefNum := -11;
  153.   ATPcall := filecall(Pb, $A004);{ control }
  154.  end;
  155.  
  156.  function OpenATPSkt (Pb : ParamBlkPtr) : integer;
  157.  begin
  158.   Pb^.csCode := 254;
  159.   OpenATPSkt := ATPcall(Pb);
  160.  end;
  161.  
  162.  function CloseATPSkt (Pb : ParamBlkPtr) : integer;
  163.  begin
  164.   Pb^.csCode := 250;
  165.   CloseATPSkt := ATPcall(Pb);
  166.  end;
  167.  
  168.  function SendRequest (Pb : ParamBlkPtr) : integer;
  169.  begin
  170.   Pb^.csCode := 255;
  171.   SendRequest := ATPcall(Pb);
  172.  end;
  173.  
  174.  function GetRequest (Pb : ParamBlkPtr) : integer;
  175.  begin
  176.   Pb^.csCode := 253;
  177.   GetRequest := ATPcall(Pb);
  178.  end;
  179.  
  180.  function SendResponse (Pb : ParamBlkPtr) : integer;
  181.  begin
  182.   Pb^.csCode := 252;
  183.   SendResponse := ATPcall(Pb);
  184.  end;
  185.  
  186.  function MPPcall (Pb : ParamBlkPtr) : integer;
  187.  begin
  188.   Pb^.ioRefNum := -10;
  189.   MPPcall := filecall(Pb, $A004);{ control }
  190.  end;
  191.  
  192.  function RegisterName (Pb : ParamBlkPtr) : integer;
  193.  begin
  194.   Pb^.csCode := 253;
  195.   RegisterName := MPPcall(Pb);
  196.  end;
  197.  
  198.  function LookupName (Pb : ParamBlkPtr) : integer;
  199.  begin
  200.   Pb^.csCode := 251;
  201.   LookupName := MPPcall(Pb);
  202.  end;
  203.  
  204.  function RemoveName (Pb : ParamBlkPtr) : integer;
  205.  begin
  206.   Pb^.csCode := 252;
  207.   RemoveName := MPPcall(Pb);
  208.  end;
  209.  
  210.  
  211.  procedure Get_Fortune;
  212.   var
  213.    Nblock, Sblock : ParamBlockRec;
  214.    myNtable : NamesTableEntry;
  215.    myTuple : ntTuple;
  216.    myBDS : BDStype;
  217.    strP : strptr;
  218.    err : integer;
  219.    reply : str255;
  220.  begin
  221.   if ATPLoad = 0 then
  222.    begin
  223.     with Nblock do
  224.      begin
  225.       interval_count[0] := chr(1);
  226.       interval_count[1] := chr(32);
  227.       strP := pointer(ord(@myNtable.none_ObjectName[1]));
  228.       pack3str(strP, '=', 'Dial-A-Fortune', '=');
  229.       entityPtr := pointer(ord(@myNtable.none_ObjectName[1]));
  230.       retBuffptr := pointer(ord(@myTuple));
  231.       retBuffsize := sizeof(myTuple);
  232.       maxToGet := 1;{ if larger use array of tuples}
  233.       err := LookupName(@Nblock);
  234.       writeln('lookup err', err);
  235.      end;{ of with Nblock }
  236.     if err = 0 then
  237.      with Sblock do
  238.       with myTuple do
  239.        begin
  240.         ATPsocket_ATPFlags[1] := chr(32);{atpXObit}
  241.         addrBlock.aNet := networkNumber;
  242.         addrBlock.aNode_Asocket[0] := nodeID_SocketNumber[0];
  243.         addrBlock.aNode_Asocket[1] := nodeID_SocketNumber[1];
  244.         reqLength := 0;{no request data}
  245.         reqPointer := nil;
  246.         bdsPointer := @myBDS;
  247.         numOfBuffs_timeoutval[0] := chr(1);{buffers}
  248.         numOfBuffs_timeoutval[1] := chr(2);{sec until retry}
  249.         numOfResps_retryCount[1] := chr(3);{retry until quit}
  250.         myBDS[0].buffsize := 256;
  251.         myBDS[0].buffPtr := pointer(ord(@reply));
  252.         err := sendRequest(@Sblock);
  253.         writeln('request err', err);
  254.         writeln('fortune returned is - ', reply);
  255.        end;
  256.    end
  257.   else
  258.    writeln('Appletalk open error ', ATPLoad);
  259.  end;
  260.  
  261. begin { main main main main main main }
  262.  showtext;
  263.  Get_Fortune;
  264. end.